unit BugReportDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ImgList, StdCtrls, Buttons, ComObj, OleCtrls, SHDocVw,
  ICore.Utils.XML, ComCtrls, ShellAPI, MSHTML;

type
  TResultBRG = (brgNone = 0, brgContinue = 1, brgRestart = 2, brgCancel = 3);

type
  TFormBugReport = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Label1: TLabel;
    Panel2: TPanel;
    WebBrowser1: TWebBrowser;
    ScrollBar1: TScrollBar;
    Image1: TImage;
    ImageList2: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure sSpeedButton5Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private
    { Private declarations }
    FReportText: AnsiString;
    FEMail: AnsiString;
    FAttachPath: string;
    FDetailHeight: Integer;
    procedure SetReportText(const Text: AnsiString); inline;
    procedure SendEMail(const RecipName: AnsiString;
                          const RecipAddress: AnsiString;
                          const Subject: AnsiString;
                          const Body: AnsiString;
                          const Attach: AnsiString);
  public
    { Public declarations }
    function ShowModalDialog(const pReportText: AnsiString;
                              const pEMail: AnsiString;
                              const pAttachPath: string = ''): TResultBRG;
    procedure GetSystemInfo;
    procedure SetGlyph(const pSpeedButton: TSpeedButton;
                        const pImageIndex: LongInt;
                        const pImageList: TImageList = nil);
    property ReportText: AnsiString read FReportText write SetReportText;
    property EMail: AnsiString read FEMail write FEMail;
    property AttachPath: string read FAttachPath write FAttachPath;
  end;

{$IFNDEF ICORE}
procedure InitializeHookExceptions;
{$ENDIF}

var
  FormBugReport: TFormBugReport;

implementation

uses
  {$IFDEF ICORE}
    ICore, ICore.Utils,
  {$ELSE}
    ICore.Log,
    Header_VerInfo,
    jclDebug,
    jclHookExcept,
  {$ENDIF}
  Mapi;

{$R *.dfm}

{$REGION 'System'}

{$IFNDEF ICORE}
const
  EMailSupport = 'Igroman14@yandex.ru';

{$REGION 'DumpModulesInLog'}
procedure DumpModulesInLog;
const
  MaxModules = 400;
type
  TModulesArray = array [0..(MaxModules - 1)] of Cardinal;
  TEnumMod = function (hProcess: THandle;
                        lphModule: LPDWORD;
                        cb: DWORD;
                        var lpcbNeeded: DWORD): Boolean; stdcall;
var
  PSAPILib: Cardinal;
//  EnumProc: Pointer;
  EnumProc: TEnumMod;
  ModulesArray: TModulesArray;
  i: Cardinal;
  FileName: array [0..(MAX_PATH - 1)] of Char;
  Descr: string;
  Ver: string;
  Counter: Integer;
begin
  Log.PrintHR;
  Log.Print('=-=-Modules-=-=');
  Counter := 0;
  PSAPILib := LoadLibrary('psapi.dll');
  try
    if (PSAPILib <> 0) then begin
      EnumProc := GetProcAddress(PSAPILib, 'EnumProcessModules');
      if (Assigned(EnumProc)) then begin
        FillChar(ModulesArray, SizeOf(TModulesArray), 0);
        if (EnumProc(GetCurrentProcess, @ModulesArray[0], MaxModules, i)) then begin
          for i := 0 to (MaxModules - 1) do
           if (ModulesArray[i] <> 0) then begin
            FillChar(FileName, MAX_PATH, 0);
            GetModuleFileName(ModulesArray[i], FileName, MAX_PATH);
            try
            Descr := AnsiString(GetFileDescription(string(FileName)));
            if (Descr <> '') then
             Descr := Descr + ': ';
            except
              {$IFDEF ICORE}
              Log.Warning('GetFileDescription - fail (' + Utils.ExtractFileNameNoExt(FileName) + ')');
              {$ELSE}
              Log.Warning('GetFileDescription - fail (' + ExtractFileName(FileName) + ')');
              {$ENDIF}
              Descr := '';
            end;
            try
              Ver := string(GetFileVersion(FileName));
            except
              {$IFDEF ICORE}
              Log.Warning('GetFileVersion - fail (' + Utils.ExtractFileNameNoExt(FileName) + ')');
              {$ELSE}
              Log.Warning('GetFileVersion - fail (' + ExtractFileName(FileName) + ')');
              {$ENDIF}
              Ver := '';
            end;
            Log.Info(FileName + ' (' + Descr + Ver + ')');
            Inc(Counter);
           end;
        end;
      end;
    end;
  finally
    FreeLibrary(PSAPILib);
    {$IFDEF ICORE}
    Log.Print('Count: ' + Utils.IntToStr(Counter));
    {$ELSE}
    Log.Print('Count: ' + IntToStr(Counter));
    {$ENDIF}
    Log.PrintHR;
  end;
end;
{$ENDREGION}

{$REGION 'DumpProcessesInLog'}
procedure DumpProcessesInLog;
var
  PE: TProcessEntry32;
  ProcessSnapShot: Cardinal;
  ProcessInfo: TProcessInfo;
  PriorityStr: AnsiString;
  Counter: Integer;
begin
  Log.PrintHR;
  Log.Print('=-=-Process-=-=');
  Counter := 0;
  PE := GetProcessEntry;
  ProcessSnapShot := GetProcSnapShot;
  if Process32First(ProcessSnapShot, PE) then
   while Process32Next(ProcessSnapShot, PE) do begin
     ProcessInfo := GetProcessInfo(ProcessSnapShot, PE);
     with ProcessInfo do begin
      case Priority of
        1..4:   PriorityStr := 'Low';
        5,6:    PriorityStr := 'UnderAverage';
        7..9:   PriorityStr := 'Average';
        10..12: PriorityStr := 'AboveAverage';
        13..23: PriorityStr := 'High';
        24:     PriorityStr := 'RealTime';
        else PriorityStr := 'NoData';
      end;
      Log.Print(string(Path));
      Log.Print(string('User\Domain: "' + ProcessInfo.User + '\' + ProcessInfo.Domain +
                  '" Description: "' + Description +
                  '" Version: "' + Version +
                  '" Priority: "' + PriorityStr +
                  {$IFDEF ICORE}
                  '" Memory: "' + Utils.IntToStr(Memory div 1024) + ' Kb' +
                  '" ID: "' + Utils.IntToStr(ID) + '"');
                  {$ELSE}
                  '" Memory: "' + IntToStr(Memory div 1024) + ' Kb' +
                  '" ID: "' + IntToStr(ID) + '"'));
                  {$ENDIF}
      Log.Print('');
      Inc(Counter);
     end;
   end;
  CloseHandle(ProcessSnapShot);
//  CloseHandle(PE);
  {$IFDEF ICORE}
  Log.Print('Count: ' + Utils.IntToStr(Counter));
  {$ELSE}
  Log.Print('Count: ' + IntToStr(Counter));
  {$ENDIF}
  Log.PrintHR;
end;
{$ENDREGION}

function GetCurrentDate(const Separate: AnsiChar = '.'): AnsiString;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := AnsiString(IntToStr(SystemTime.wYear)) + Separate +
            AnsiString(IntToStr(SystemTime.wMonth)) + Separate +
            AnsiString(IntToStr(SystemTime.wDay));
end;

function GetCurrentTime: AnsiString;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := AnsiString(IntToStr(SystemTime.wHour)) + ':' +
            AnsiString(IntToStr(SystemTime.wMinute)) + ':' +
            AnsiString(IntToStr(SystemTime.wSecond)) + '.' +
            AnsiString(IntToStr(SystemTime.wMilliseconds));
end;


{$REGION 'BugReport'}
function GetExceptionString: AnsiString; inline;
var
  i: Integer;
begin
  Result := '';
  if (JclLastExceptStackList <> nil) then begin
    for i := 0 to JclLastExceptStackList.Count - 1 do
     with JclLastExceptStackList do
      {$IFDEF ICORE}
      Result := Result + GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True) + ICore.Utils.CRLF;
      {$ELSE}
      Result := Result + AnsiString(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True)) + AnsiString(CRLF);
      {$ENDIF}
  end else
   {$IFDEF ICORE}
   Result := '[NOT AVAILABLE]' + ICore.Utils.CRLF;
   {$ELSE}
   Result := '[NOT AVAILABLE]' + CRLF;
   {$ENDIF}
end;

procedure AllExceptionsNotify(ExceptObj: TObject;
                                ExceptAddr: Pointer;
                                OSExcept: Boolean);
var
  i: Integer;
  ErrStr: AnsiString;
begin
  ErrStr := '';
  Log.PrintHR;
  Log.Print('=-=-Exception-=-=');
  if (JclLastExceptStackList <> nil) then begin
    for i := 0 to JclLastExceptStackList.Count - 1 do
     with JclLastExceptStackList do begin
       {$IFDEF ICORE}
       ErrStr := ErrStr + GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True) + ICore.Utils.CRLF;
       {$ELSE}
       ErrStr := ErrStr + AnsiString(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True)) + AnsiString(CRLF);
       {$ENDIF}
       Log.Error(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True));
     end;
  end else begin
    {$IFDEF ICORE}
    ErrStr := '[NOT AVAILABLE]' + ICore.Utils.CRLF;
    {$ELSE}
    ErrStr := '[NOT AVAILABLE]' + CRLF;
    {$ENDIF}
    Log.Error(ErrStr);
  end;
  Log.PrintHR;

//  Log.Error(ErrStr);
  {$IFDEF ICORE}
  FormBugReport.ShowModalDialog(ErrStr,
                                  Core.EMailSupport,
                                  Utils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  FormBugReport.ShowModalDialog(ErrStr,
                                  EMailSupport,
                                  ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
end;

procedure InitializeHookExceptions;
begin
  Include(JclStackTrackingOptions, stRawMode);
  Include(JclStackTrackingOptions, stStaticModuleList);
  JclStartExceptionTracking;
  JclAddExceptNotifier(AllExceptionsNotify);
end;
{$ENDREGION}

{$ENDIF}

{$ENDREGION}

procedure TFormBugReport.FormCreate(Sender: TObject);
begin
  FormBugReport.Constraints.MinWidth := Width;
  FormBugReport.Constraints.MinHeight := Height - Panel2.Height;
  FDetailHeight := Panel2.Height;

  SetGlyph(SpeedButton1, 0);
  SetGlyph(SpeedButton2, 1);
  SetGlyph(SpeedButton3, 2);
  SetGlyph(SpeedButton4, 3);

  Image1.Canvas.Brush.Color := clNone;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
  ImageList2.GetBitmap(0, Image1.Picture.Bitmap);
end;

procedure TFormBugReport.SetReportText(const Text: AnsiString);
begin
  FReportText := Text;
end;

procedure TFormBugReport.ScrollBar1Change(Sender: TObject);
var
  HtmlDoc: IHTMLDocument2;
begin
  HtmlDoc := IHTMLDocument2(WebBrowser1.Document);
  if (HtmlDoc <> nil) then
   HtmlDoc.parentWindow.scroll(0, ScrollBar1.Position);
end;

procedure TFormBugReport.SendEMail(const RecipName: AnsiString;
                                    const RecipAddress: AnsiString;
                                    const Subject: AnsiString;
                                    const Body: AnsiString;
                                    const Attach: AnsiString);
var
  MAPIMessage: TMapiMessage;
  MAPIFileDesc: TMapiFileDesc;
  MAPIRecipDesc: TMapiRecipDesc;
begin
  with MAPIRecipDesc do begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PAnsiChar(RecipName);
    lpszAddress := PAnsiChar(RecipAddress);
    ulEIDSize := 0;
    lpEntryID := nil;
  end;

  with MAPIFileDesc do begin
    ulReserved := 0;
    flFlags := 0;
    nPosition := 0;
    lpszPathName := PAnsiChar(Attach);
    lpszFileName := nil;
    lpFileType := nil;
  end;

  with MAPIMessage do begin
    ulReserved := 0;
    lpszSubject := PAnsiChar(Subject);
    lpszNoteText := PAnsiChar(Body);
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    nRecipCount := 1;
    lpRecips := @MAPIRecipDesc;
    if (Length(Attach) > 0) then begin
      nFileCount := 1;
      lpFiles := @MAPIFileDesc;
    end else begin
      nFileCount := 0;
      lpFiles := nil;
    end;
  end;

  if (MapiSendMail(0,
                    0,
                    MAPIMessage,
                    MAPI_DIALOG or MAPI_LOGON_UI or   MAPI_NEW_SESSION,
                    0) <> SUCCESS_SUCCESS)then begin
    Log.Error('SendMail - failed');
  end;
end;

function TFormBugReport.ShowModalDialog(const pReportText: AnsiString;
                                          const pEMail: AnsiString;
                                          const pAttachPath: string = ''): TResultBRG;
begin
  ReportText := pReportText;
  EMail := pEMail;
  AttachPath := pAttachPath;
  {$IFDEF ICORE}
  Utils.DumpModulesInLog;
  Utils.DumpProcessesInLog;
  WebBrowser1.Navigate(TUtils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  DumpModulesInLog;
  DumpProcessesInLog;
  WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
  FormBugReport.ShowModal;
  Result := TResultBRG(ModalResult);
end;

procedure TFormBugReport.SpeedButton1Click(Sender: TObject);
begin
  Close;
end;

procedure TFormBugReport.SpeedButton2Click(Sender: TObject);
begin
  Application.Terminate;
  {$IFDEF ICORE}
  TUtils.SwitchToProgNoWait(ParamStr(0));
  {$ELSE}
  ShellExecute(0, 'open', PChar(ParamStr(0)), nil, nil, SW_SHOW);
  {$ENDIF}
end;

procedure TFormBugReport.SpeedButton3Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFormBugReport.SpeedButton4Click(Sender: TObject);
var
  Mail: OleVariant;
begin
  {$IFDEF ICORE}
  SendEMail('BugReport', EMail, 'BugReport_' + TUtils.GetCurrentDate('_') + ' (' + TUtils.GetCurrentTime + ')', ReportText, AttachPath);
  {$ELSE}
  SendEMail('BugReport', EMail, 'BugReport_' + GetCurrentDate('_') + ' (' + GetCurrentTime + ')', ReportText, AnsiString(AttachPath));
  {$ENDIF}
end;

procedure TFormBugReport.SpeedButton5Click(Sender: TObject);
begin
  Panel2.Visible := not Panel2.Visible;
  if Panel2.Visible then
   FormBugReport.Height := FormBugReport.Constraints.MinHeight + FDetailHeight
  else
   FormBugReport.Height := FormBugReport.Constraints.MinHeight;

  {$IFDEF ICORE}
  WebBrowser1.Navigate(TUtils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
end;

procedure TFormBugReport.GetSystemInfo;
begin
end;

procedure TFormBugReport.SetGlyph(const pSpeedButton: TSpeedButton;
                                    const pImageIndex: Integer;
                                    const pImageList: TImageList = nil);
var
  tmpBitmap: TBitmap;
begin
  tmpBitmap := pSpeedButton.Glyph;
  tmpBitmap.Canvas.Brush.Color := clNone;
  tmpBitmap.Canvas.FillRect(tmpBitmap.Canvas.ClipRect);
  try
    if (pImageList = nil) then
     ImageList1.GetBitmap(pImageIndex, tmpBitmap)
    else
     pImageList.GetBitmap(pImageIndex, tmpBitmap);
    pSpeedButton.Glyph := tmpBitmap;
  finally
  end;
end;

procedure TFormBugReport.sSpeedButton5Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFormBugReport.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  ScrollBar1.Max := WebBrowser1.OleObject.Document.Body.scrollHeight;
end;

end.
